2 REM   ******************************************

3 REM   ** (DFT9.01) GENERATE/ANALYZE WAVEFORM  **

4 REM   **    THIS PROGRAM DEMONSTRATES THE     **

5 REM   **   STRETCHING THEOREM FOR POSITIVE    **

6 REM   **          FREQUENCIES ONLY            **

8 REM   ******************************************

10 Q = 32

12 PI = 3.141592653589793#: P2 = 2 * PI: K1 = P2 / Q: K2 = 1 / PI

14 DIM C(2, Q), S(2, Q), KC(2, Q), KS(2, Q)

16 CLS : FOR J = 0 TO Q: FOR I = 1 TO 2: C(I, J) = 0: S(I, J) = 0: NEXT: NEXT

20 CLS : REM *    MAIN MENU    *

22 PRINT : PRINT : PRINT "         MAIN MENU": PRINT

24 PRINT " 1 = STRETCHING THEOREM": PRINT

31 PRINT " 2 = EXIT": PRINT : PRINT

32 PRINT SPC(10); "MAKE SELECTION";

34 A$ = INKEY$: IF A$ = "" THEN 34

36 A = VAL(A$): ON A GOSUB 300, 1000

38 GOTO 20

40 CLS : N = 1: M = 2: K5 = Q2: K6 = -1: GOSUB 108

42 FOR J = 0 TO Q: C(2, J) = 0: S(2, J) = 0: NEXT

44 GOSUB 200: REM - PERFORM DFT

46 GOSUB 140: REM - PRINT OUT FINAL VALUES

48 PRINT : INPUT "C/R TO CONTINUE"; A$

50 RETURN

80 CLS : GOSUB 150: REM PRINT HEADING

81 FOR I = 0 TO Q - 1: C(1, I) = 0: S(1, I) = 0: NEXT

82 N = 2: M = 1: K5 = 1: K6 = 1

84 GOSUB 200: REM INVERSE TRANSFORM

86 GOSUB 140: REM PRINT OUTPUT

88 PRINT : INPUT "C/R TO CONTINUE"; A$

90 RETURN

100 REM  ******************************************

102 REM  *         PROGRAM SUBROUTINES            *

104 REM  ******************************************

106 REM  *       PRINT COLUMN HEADINGS            *

108 PRINT : PRINT : IF COR$ = "P" THEN 116

110 PRINT "FREQ    F(COS)      F(SIN)      FREQ     F(COS)    F(SIN)"

112 PRINT

114 RETURN

116 PRINT "FREQ      F(MAG)       F(THETA)    FREQ       F(MAG)     F(THETA)"

118 GOTO 112

137 REM ******************************

138 REM *       PRINT OUTPUT         *

139 REM ******************************

140 IF COR$ = "P" AND M = 2 THEN GOSUB 170

141 FOR Z = 0 TO Q / 2 - 1

142 PRINT USING "##_     "; Z;

144 PRINT USING "+###.#####_    "; C(M, Z); S(M, Z);

145 PRINT USING "##_    "; (Z + Q / 2);

146 PRINT USING "+###.#####_    "; C(M, Z + Q / 2); S(M, Z + Q / 2)

147 NEXT Z

148 RETURN

150 REM ******************************

152 REM *    PRINT COLUMN HEADINGS   *

154 PRINT

156 PRINT "                       RECONSTRUCTION": PRINT

158 PRINT " T                              T": PRINT

160 RETURN

170 REM CONVERT FROM RECTANGULAR TO POLAR COORDINATES

172 FOR I = 0 TO Q - 1

174 MAG = SQR(C(M, I) ^ 2 + S(M, I) ^ 2)

175 IF C(M, I) = 0 THEN 190

176 ANGLE = 180 / PI * ATN(S(M, I) / C(M, I))

177 IF C(M, I) > 0 THEN S(M, I) = ANGLE: GOTO 180

178 IF ANGLE > 0 THEN S(M, I) = ANGLE - 180

179 IF ANGLE < 0 THEN S(M, I) = ANGLE + 180

180 C(M, I) = MAG: NEXT

182 RETURN

190 IF S(M, I) = 0 THEN S(M, I) = 0: GOTO 180

192 S(M, I) = 90: GOTO 180

200 REM *******************************

202 REM *     TRANSFORM/RECONSTRUCT   *

204 REM *******************************

206 FOR J = 0 TO Q2: REM SOLVE EQNS FOR POSITIVE FREQUENCIES

208 FOR I = 0 TO Q - 1: REM MULTIPLY AND SUM EACH POINT

210 C(M, J) = C(M, J) + C(N, I) * COS(J * I * K1) + K6 * S(N, I) * SIN(J * I * K1)

211 S(M, J) = S(M, J) - K6 * C(N, I) * SIN(J * I * K1) + S(N, I) * COS(J * I * K1)

212 NEXT I

214 C(M, J) = C(M, J) / K5: S(M, J) = S(M, J) / K5: REM SCALE RESULTS

216 NEXT J

218 RETURN

220 REM *******************************

222 REM *        PLOT FUNCTIONS       *

224 REM *******************************

225 SFF = 4: SFT = 64

226 SCREEN 9, 1, 1, 1: COLOR 9, 1: CLS : YF = -1: YT = -1

228 LINE (0, 5)-(0, 155): LINE (0, 160)-(0, 310)

230 LINE (0, 155)-(600, 155): LINE (0, 235)-(600, 235)

232 GOSUB 266

234 COLOR 15, 1

236 FOR N = 0 TO Q - 1

238 GOSUB 260

240 LINE (X, Y)-(X, Y): LINE (X, Z)-(X, Z)

242 NEXT N

244 LOCATE 2, 10: PRINT "FREQUENCY DOMAIN (MAG)"

246 LOCATE 20, 15: PRINT "TIME DOMAIN"

248 LOCATE 24, 1

250 INPUT "C/R TO CONTINUE"; A$

252 SCREEN 0, 0, 0

254 RETURN

256 REM *******************************

260 Y = C(2, N): Y = 155 - (YF * Y)

262 X = N * 600 / Q: Z = 235 - (YT * C(1, N))

264 RETURN

265 REM *******************************

266 YF = 150 / SFF: YT = 150 / SFT: LINE (0, 5)-(5, 5): LINE (0, 80)-(5, 80)

268 LINE (0, 160)-(5, 160): LINE (0, 235)-(5, 235)

270 LOCATE 1, 2: PRINT SFF: LOCATE 6, 2: PRINT SFF / 2

272 LOCATE 12, 2: PRINT "+"; SFT / 2: LOCATE 23, 2: PRINT "-"; SFT / 2

274 RETURN

299 REM *******************************

300 CLS : REM *   STRETCHING THEOREM    *

301 REM *******************************

302 FOR I = 0 TO Q - 1: C(1, I) = 0: S(1, I) = 0

304 FOR J = 1 TO 2: KC(J, I) = 0: KS(J, I) = 0: NEXT: NEXT

305 COR$ = "P": Q = 16: K1 = P2 / Q: Q2 = Q / 2

306 GOSUB 900

308 REM *** GENERATE "Z1" FUNCTION ***

310 PRINT : PRINT SPC(18); " - Z1 - FUNCTION": PRINT

312 C(1, 0) = 8: C(1, 1) = -8: C(1, 2) = 8: C(1, 3) = -8

314 GOSUB 158: REM PRINT HEADING

316 M = 1: GOSUB 140: REM PRINT INPUT FUNCTION

318 PRINT : INPUT "C/R TO CONTINUE"; A$

320 GOSUB 40: REM TAKE XFORM

322 GOSUB 220: REM PLOT DATA

324 FOR I = 0 TO Q - 1: C(1, I) = 0: S(1, I) = 0: NEXT

326 Q = 32: K1 = P2 / Q: Q2 = Q / 2

328 C(1, 0) = 8: C(1, 2) = -8: C(1, 4) = 8: C(1, 6) = -8

330 GOSUB 158: REM PRINT HEADING

332 M = 1: GOSUB 140: REM PRINT INPUT FUNCTION

334 PRINT : INPUT "C/R TO CONTINUE"; A$

336 GOSUB 40: REM TAKE XFORM

338 GOSUB 220: REM PLOT DATA

396 RETURN

900 CLS : SCREEN 9, 1, 1: COLOR 15, 1: REM TEST DESCRIPTION

902 FOR DACNT = 1 TO 11

904 READ A$: PRINT A$

906 NEXT

908 INPUT "C/R TO CONTINUE"; A$

910 SCREEN 0, 0, 0: RETURN

920 DATA "                STRETCHING THEOREM TEST"

922 DATA " "

924 DATA "In this illustration we generate a very simple function which has "

926 DATA "two primary characteristics: it is easy to generate and it has a   "

928 DATA "a distinctive spectrum  - it is easy to manipulate and easy to"

930 DATA "recognize.  First we generate the function and analyze it (16 data "

932 DATA "points and 16 frequency components).  Then we intersperse zeros and"

934 DATA "analyze the function a second time (now we have 32 data points"

936 DATA "and 32 frequency components).  The results well illustrate the"

938 DATA "stretching Theorem."

940 DATA " "

942 DATA " "

1000 END



